VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBulletin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'THIS CLASS ENCAPSULATS THE BULLETIN FUNCTIONALLITY, IT WILL CHECK FOR NEW
'BULLETINS, AND EXPOSE THE FUNCTIONALLITY TO FETCH ALL BULLETINS FOR A
'USER AND COMPANY IF TODAY FALLS BETWEEN THE START AND END DATES FOR
'ANY BULLETINS.

Public Function FindBulletins() As String
    'this function checks to see if there are any bulletins for the
    'company specified that are still in active (today falls between the start
    'and end dates for the bulletin)
    
    Dim rsBulletins As ADODB.Recordset
    Dim cmdFind As ADODB.Command
    
    On Error GoTo PROC_ERROR
    
    Set cmdFind = New ADODB.Command
    Set rsBulletins = New ADODB.Recordset
    
    'check the connection object
    Call modGeneral.dbConnect
    
    'set up the command
    With cmdFind
        .CommandText = "dir_check_bulletins"
        .CommandType = adCmdStoredProc
        .ActiveConnection = modGeneral.obj_ADOConn
        .Prepared = True
        
        'execute the proc
        Set rsBulletins = .Execute
    End With
    
    'get the data
    If rsBulletins.EOF = True And rsBulletins.BOF = True Then
        'there were no records returned, this should never happen because
        'if there are no bulletins a 'N' is returned from the stored proc
        Err.Raise vbErrorNumbers.KT_FIND_BULLETINS, "KT_Search.clsBulletins.FindBulletins", "Bulletin recordset is empty."
    End If
    
    'pass out Y/N
    FindBulletins = rsBulletins("bulletins_exist")
    
    'deallocate objects
    Set cmdFind = Nothing
    rsBulletins.Close
    Set rsBulletins = Nothing
    modGeneral.obj_ADOConn.Close
    Set modGeneral.obj_ADOConn = Nothing
    
Exit Function
PROC_ERROR:
    Err.Raise vbErrorNumbers.KT_FIND_BULLETINS, Err.Description & " - clsBulletin.FindBulletins"
End Function

Public Function GetBulletins() As String
    'this function will return the actual bulletin
    
    On Error GoTo PROC_ERROR
    
    Dim cmdGet As ADODB.Command
    Dim rsBulletin As ADODB.Recordset
    Dim strHTML As String
    
    Set rsBulletin = New ADODB.Recordset
    Set cmdGet = New ADODB.Command
    
    'connect to the database
    Call modGeneral.dbConnect

    'set up the command
    With cmdGet
        .ActiveConnection = modGeneral.obj_ADOConn
        .CommandText = "dir_get_bulletins"
        .CommandType = adCmdStoredProc
        
        Set rsBulletin = .Execute
    End With

    'check the rs
    If rsBulletin.EOF = True And rsBulletin.BOF = True Then
        'there were no records returned for this com_id, this should !*NEVER*! happen
        Err.Raise vbErrorNumbers.KT_GET_BULLETINS, "KT_Search.clsBulletin.GetBulletins"
    End If

    'generate the HTML table
    Do While rsBulletin.EOF = False
        strHTML = strHTML & "<tr> " & _
                  "<td class=""FormHeadingCell"">" & CStr(rsBulletin("bulletin_topic")) & "</td>" & _
                  "</tr>" & _
                  "<tr>" & _
                  "<td class=""FormLeftCell"">" & CStr(rsBulletin("bulletin_text")) & "</td>" & _
                  "</tr>" & _
                  "</TABLE><br><TABLE class=""FormTable"" cellpadding=2 cellspacing=1 align=center style=""width:90%"">"
        rsBulletin.MoveNext
    Loop
    
    'deallocate objects
    Set cmdGet = Nothing
    rsBulletin.Close
    Set rsBulletin = Nothing
    modGeneral.obj_ADOConn.Close
    Set modGeneral.obj_ADOConn = Nothing

    GetBulletins = strHTML
    Exit Function
PROC_ERROR:
    Err.Raise vbErrorNumbers.KT_GET_BULLETINS, "KT_Search.clsBulletin.GetBulletins", Err.Description
End Function

Public Function CreateNewBulletin(ByVal dtStartDate As String, _
                                  ByVal dtStartTime As String, _
                                  ByVal dtEndDate As String, _
                                  ByVal dtEndTime As String, _
                                  ByVal strBulletinTopic As String, _
                                  ByVal strBulletinText As String) As String
                             


    'this sub will create a new bulletin in the database

On Error GoTo PROC_ERROR
    
    Dim strSQL As String
    Dim lngRecordsAffected As Long
    Dim strErrMSG As String
    Dim dtStartDateTime
    Dim dtEndDateTime
    Dim dtLastModified
    
    'connect to the database
    Call modGeneral.dbConnect
   
    Dim cnNewBulletin As ADODB.Connection
    
    Dim objConn As Object
    Dim cmd As ADODB.Command
    
    Set cnNewBulletin = New ADODB.Connection
    Set objConn = CreateObject("Connect.ClsConnect")
    
    With cnNewBulletin
        .CursorLocation = adUseClient
        .IsolationLevel = adXactBrowse
        .ConnectionString = objConn.ConnectionString
        .Open
    End With
    
    If dtEndDate = "" Then
        dtEndDate = "NULL"
    End If
        
    Set cmd = New ADODB.Command
    cmd.CommandText = "dir_insert_bulletins"
    cmd.CommandType = adCmdStoredProc
    cmd.ActiveConnection = cnNewBulletin
    
    dtStartDate = dtStartDate & " " & dtStartTime
    dtStartDateTime = CDate(Format(dtStartDate, "dd/mm/yyyy hh:mm:ss"))
    
    dtEndDate = dtEndDate & " " & dtEndTime
    dtEndDateTime = CDate(Format(dtEndDate, "dd/mm/yyyy hh:mm:ss"))
    
    dtLastModified = Now
    dtLastModified = CDate(Format(dtLastModified, "dd/mm/yyyy hh:mm:ss"))
    
    
    With cmd
     .Parameters.Append cmd.CreateParameter("dtStartDateTime", adDBTimeStamp, adParamInput, , dtStartDateTime)
     .Parameters.Append cmd.CreateParameter("dtEndDateTime", adDBTimeStamp, adParamInput, , dtEndDateTime)
     .Parameters.Append cmd.CreateParameter("dtLastModified", adDBTimeStamp, adParamInput, , dtLastModified)
     .Parameters.Append cmd.CreateParameter("strBulletinTopic", adVarChar, adParamInput, 200, strBulletinTopic)
     .Parameters.Append cmd.CreateParameter("strBulletinText", adVarChar, adParamInput, 4000, strBulletinText)
     .Parameters.Append cmd.CreateParameter("next_val", adDouble, adParamOutput)
    End With 'cmd
    
    cmd.Execute lngRecordsAffected
    
    If lngRecordsAffected >= 1 Then
        strErrMSG = cmd.Parameters("next_val").Value
        Exit Function
    Else
        strErrMSG = "false"
    End If
    
    CreateNewBulletin = strErrMSG
    
   
    'clean up in called function
    cnNewBulletin.Close
    Set cnNewBulletin = Nothing

    Exit Function
    
PROC_ERROR:
    Err.Raise vbErrorNumbers.KT_CREATE_NEW_BULLETIN, "KT_Search.clsBulletin.CreateNewBulletin", Err.Description
End Function

Public Function StringDateToDateTimeStamp(ByVal dtStringDate As String) As String
    
    StringDateToDateTimeStamp = DateSerial(Left$(dtStringDate, 4), Mid$(dtStringDate, 5, 2), Right$(dtStringDate, 2))
        
    StringDateToDateTimeStamp = CStr(StringDateToDateTimeStamp)
    
End Function





